home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / adaptcm.c next >
Text File  |  1994-01-03  |  13KB  |  520 lines
  1. # include "CM.h"
  2. # include "yyACM.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 18 "AdaptCM.puma"
  36.  
  37. # include <stdio.h>
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40.  
  41. # include "protocol.h"
  42.  
  43. # include "Types.h"
  44. # include "Transfor.h"    /* ExpToVarParam */
  45. # include "Dalib.h"        /* IsHost, MakeVarDecl... */
  46.  
  47. # include "Broadcas.h" /* MakeParamBroadcast */
  48. # include "Local.h"     /* MakeRangeStmt */
  49.  
  50. # include "Globals.h"        /* GenGlobalSend, GenGlobalGet */
  51.  
  52.  
  53.  
  54. static FILE * yyf = stdout;
  55.  
  56. static void yyAbort
  57. # ifdef __cplusplus
  58.  (char * yyFunction)
  59. # else
  60.  (yyFunction) char * yyFunction;
  61. # endif
  62. {
  63.  (void) fprintf (stderr, "Error: module AdaptCM, routine %s failed\n", yyFunction);
  64.  exit (1);
  65. }
  66.  
  67. bool IsCMIntrinsic ARGS((tTree t));
  68. bool IsCMSubroutine ARGS((tIdent name));
  69. tTree AdaptCMIntrinsic ARGS((tTree t));
  70. static tTree GenRandom ARGS((tTree t));
  71. static tTree GenRandom1 ARGS((tTree t, int dist));
  72. static void MakeRandomProc ARGS((tTree t, tTree type));
  73. static tTree GenRandomize ARGS((tTree t));
  74.  
  75. bool IsCMIntrinsic
  76. # if defined __STDC__ | defined __cplusplus
  77. (register tTree t)
  78. # else
  79. (t)
  80.  register tTree t;
  81. # endif
  82. {
  83.   if (t == NoTree) return false;
  84.   if (t->Kind == kPROC_OBJ) {
  85. # line 39 "AdaptCM.puma"
  86.   {
  87. # line 40 "AdaptCM.puma"
  88.    IsIntrFunc (t);
  89. # line 41 "AdaptCM.puma"
  90.    if (! (IsCMSubroutine (t->PROC_OBJ.Ident))) goto yyL1;
  91.   }
  92.    return true;
  93. yyL1:;
  94.  
  95.   }
  96.   return false;
  97. }
  98.  
  99. bool IsCMSubroutine
  100. # if defined __STDC__ | defined __cplusplus
  101. (register tIdent name)
  102. # else
  103. (name)
  104.  register tIdent name;
  105. # endif
  106. {
  107.   if (equaltIdent (name, MakeIdent ("CMF_RANDOM", 10))) {
  108. # line 46 "AdaptCM.puma"
  109.    return true;
  110.  
  111.   }
  112.   if (equaltIdent (name, MakeIdent ("CMF_RANDOMIZE", 13))) {
  113. # line 47 "AdaptCM.puma"
  114.    return true;
  115.  
  116.   }
  117.   if (equaltIdent (name, MakeIdent ("WALLTIME", 8))) {
  118. # line 49 "AdaptCM.puma"
  119.    return true;
  120.  
  121.   }
  122.   if (equaltIdent (name, MakeIdent ("CM_TIMER_CLEAR", 14))) {
  123. # line 50 "AdaptCM.puma"
  124.    return true;
  125.  
  126.   }
  127.   if (equaltIdent (name, MakeIdent ("CM_TIMER_START", 14))) {
  128. # line 51 "AdaptCM.puma"
  129.    return true;
  130.  
  131.   }
  132.   if (equaltIdent (name, MakeIdent ("CM_TIMER_STOP", 13))) {
  133. # line 52 "AdaptCM.puma"
  134.    return true;
  135.  
  136.   }
  137.   if (equaltIdent (name, MakeIdent ("CM_TIMER_PRINT", 14))) {
  138. # line 53 "AdaptCM.puma"
  139.    return true;
  140.  
  141.   }
  142.   if (equaltIdent (name, MakeIdent ("GLOBAL_GET", 10))) {
  143. # line 54 "AdaptCM.puma"
  144.    return true;
  145.  
  146.   }
  147.   if (equaltIdent (name, MakeIdent ("GLOBAL_SEND", 11))) {
  148. # line 55 "AdaptCM.puma"
  149.    return true;
  150.  
  151.   }
  152.   return false;
  153. }
  154.  
  155. tTree AdaptCMIntrinsic
  156. # if defined __STDC__ | defined __cplusplus
  157. (register tTree t)
  158. # else
  159. (t)
  160.  register tTree t;
  161. # endif
  162. {
  163. # line 60 "AdaptCM.puma"
  164.  
  165. tTree newacf;
  166. char string [100];
  167.  
  168.   if (t->Kind == kACF_BASIC) {
  169.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  170.   if (Definitions_IsType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object, kObject)) {
  171. # line 65 "AdaptCM.puma"
  172.   {
  173. # line 67 "AdaptCM.puma"
  174.    stmt_protocol ("Transform Intrinscic Subroutine");
  175. # line 68 "AdaptCM.puma"
  176.  if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CMF_RANDOM",10) )
  177.        {
  178.          newacf = GenRandom (t);
  179.        }
  180.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CMF_RANDOMIZE",13) )
  181.        {
  182.          newacf = GenRandomize (t);
  183.        }
  184.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("WALLTIME",8) )
  185.        {
  186.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("walltime");
  187.          newacf = t;
  188.        }
  189.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_CLEAR",14) )
  190.        {
  191.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("clear_timer");
  192.          newacf = t;
  193.        }
  194.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_STOP",13) )
  195.        {
  196.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("stop_timer");
  197.          newacf = t;
  198.        }
  199.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_PRINT",14) )
  200.        {
  201.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("print_timer");
  202.          newacf = t;
  203.        }
  204.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_START",14) )
  205.        {
  206.          t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("start_timer");
  207.          newacf = t;
  208.        }
  209.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("GLOBAL_SEND",11) )
  210.        {
  211.          if (IsHost)
  212.               newacf = NoTree;
  213.            else
  214.               newacf = GenGlobalSend (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  215.        }
  216.      else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("GLOBAL_GET",10) )
  217.        {
  218.          if (IsHost)
  219.               newacf = NoTree;
  220.            else
  221.               newacf = GenGlobalGet (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
  222.        }
  223.      else
  224.        { GetString (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident, string);
  225.          printf ("Adaption of CM intrinsic %s failed\n", string);
  226.          exit (-1);
  227.        }
  228.  
  229. # line 121 "AdaptCM.puma"
  230.    tree_protocol ("New Call is \n", newacf);
  231.   }
  232.    return newacf;
  233.  
  234.   }
  235.   }
  236.   if (t->ACF_BASIC.BASIC_STMT->Kind == kGLOBAL_STMT) {
  237. # line 125 "AdaptCM.puma"
  238.   {
  239. # line 126 "AdaptCM.puma"
  240.  stmt_protocol ("Transform Global Statement");
  241.  
  242.       tree_protocol ("New Call is \n", newacf);
  243.  
  244.   }
  245.    return newacf;
  246.  
  247.   }
  248.   }
  249.  yyAbort ("AdaptCMIntrinsic");
  250. }
  251.  
  252. static tTree GenRandom
  253. # if defined __STDC__ | defined __cplusplus
  254. (register tTree t)
  255. # else
  256. (t)
  257.  register tTree t;
  258. # endif
  259. {
  260.   if (t->Kind == kACF_BASIC) {
  261.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  262.   if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
  263.   if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  264. # line 141 "AdaptCM.puma"
  265.    return GenRandom1 (t, TreeDistribution (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
  266.  
  267.   }
  268.   }
  269.   }
  270.   }
  271.  yyAbort ("GenRandom");
  272. }
  273.  
  274. static tTree GenRandom1
  275. # if defined __STDC__ | defined __cplusplus
  276. (register tTree t, register int dist)
  277. # else
  278. (t, dist)
  279.  register tTree t;
  280.  register int dist;
  281. # endif
  282. {
  283.   if (t->Kind == kACF_BASIC) {
  284.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  285.   if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
  286.   if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  287.   if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kINDEXED_VAR) {
  288.  {
  289.   tTree stmt;
  290.   tTree new;
  291.   if (equalint (dist, 0)) {
  292. # line 148 "AdaptCM.puma"
  293.   {
  294. # line 152 "AdaptCM.puma"
  295.  
  296. # line 153 "AdaptCM.puma"
  297.  
  298. # line 155 "AdaptCM.puma"
  299.  new = MakeParamBroadcast (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem);
  300.  
  301.     MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
  302.     stmt = DoSingleNode (t);
  303.     if (stmt != NoTree)
  304.        new = mACF_LIST (stmt, new);
  305.  
  306.   }
  307.   {
  308.    return new;
  309.   }
  310.  
  311.   }
  312.  }
  313.   if (equalint (dist, - 1)) {
  314. # line 165 "AdaptCM.puma"
  315.   {
  316. # line 169 "AdaptCM.puma"
  317.    if (! ((IsHost == true))) goto yyL2;
  318.   {
  319. # line 170 "AdaptCM.puma"
  320.  MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
  321.   }
  322.   }
  323.    return t;
  324. yyL2:;
  325.  
  326.   }
  327.   if (equalint (dist, 1)) {
  328. # line 178 "AdaptCM.puma"
  329.   {
  330. # line 182 "AdaptCM.puma"
  331.    if (! ((IsHost == true))) goto yyL4;
  332.   }
  333.    return NoTree;
  334. yyL4:;
  335.  
  336.   }
  337.  {
  338.   tTree new;
  339.   if (equalint (dist, 1)) {
  340. # line 186 "AdaptCM.puma"
  341.   {
  342. # line 190 "AdaptCM.puma"
  343.    if (! ((TreeRank (LastIndex (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS)) == 0))) goto yyL5;
  344.   {
  345. # line 192 "AdaptCM.puma"
  346.  
  347. # line 194 "AdaptCM.puma"
  348.  new = MaskNodeStmt (t, t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  349.      MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
  350.  
  351.   }
  352.   }
  353.   {
  354.    return new;
  355.   }
  356. yyL5:;
  357.  
  358.   }
  359.  }
  360.  {
  361.   tTree new;
  362.   if (equalint (dist, 1)) {
  363. # line 201 "AdaptCM.puma"
  364.   {
  365. # line 205 "AdaptCM.puma"
  366.  
  367. # line 207 "AdaptCM.puma"
  368.  new = MakeRangeStmt (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, LastIndex (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS));
  369.     MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
  370.     if (new != NoTree)
  371.        new = mACF_LIST (new, mACF_LIST (t, NoTree));
  372.      else
  373.        new = t;
  374.  
  375.   }
  376.   {
  377.    return new;
  378.   }
  379.  
  380.   }
  381.  }
  382.   }
  383.   }
  384.   }
  385.   }
  386.   }
  387.   if (equalint (dist, - 1)) {
  388. # line 174 "AdaptCM.puma"
  389.    return NoTree;
  390.  
  391.   }
  392. # line 217 "AdaptCM.puma"
  393.   {
  394. # line 218 "AdaptCM.puma"
  395.    failure_protocol ("AdaptCM", "GenRandom1", t);
  396.   }
  397.    return NoTree;
  398.  
  399. }
  400.  
  401. static void MakeRandomProc
  402. # if defined __STDC__ | defined __cplusplus
  403. (register tTree t, register tTree type)
  404. # else
  405. (t, type)
  406.  register tTree t;
  407.  register tTree type;
  408. # endif
  409. {
  410. # line 224 "AdaptCM.puma"
  411.  
  412. tTree size;
  413.  
  414.   if (t == NoTree) return;
  415.   if (type == NoTree) return;
  416.   if (t->Kind == kCALL_STMT) {
  417.   if (t->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
  418.   if (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  419.   if (type->Kind == kINTEGER_TYPE) {
  420.   if (equalint (type->INTEGER_TYPE.size, 4)) {
  421. # line 228 "AdaptCM.puma"
  422.   {
  423. # line 230 "AdaptCM.puma"
  424.  t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_int_randoms"));
  425.     size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
  426.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
  427.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  428.  
  429.   }
  430.    return;
  431.  
  432.   }
  433.   }
  434.   if (type->Kind == kREAL_TYPE) {
  435.   if (equalint (type->REAL_TYPE.size, 4)) {
  436. # line 237 "AdaptCM.puma"
  437.   {
  438. # line 239 "AdaptCM.puma"
  439.  t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_real_randoms"));
  440.     size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
  441.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
  442.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  443.  
  444.   }
  445.    return;
  446.  
  447.   }
  448.   if (equalint (type->REAL_TYPE.size, 8)) {
  449. # line 246 "AdaptCM.puma"
  450.   {
  451. # line 248 "AdaptCM.puma"
  452.  t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_double_randoms"));
  453.     size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
  454.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
  455.     t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
  456.  
  457.   }
  458.    return;
  459.  
  460.   }
  461.   }
  462.   }
  463.   }
  464.   }
  465. # line 255 "AdaptCM.puma"
  466.   {
  467. # line 256 "AdaptCM.puma"
  468.    printf ("MakeRandomProc failed, illegal type");
  469. # line 257 "AdaptCM.puma"
  470.    WriteTree (stdout, t);
  471. # line 258 "AdaptCM.puma"
  472.    kill_in_protocol ();
  473.   }
  474.    return;
  475.  
  476. ;
  477. }
  478.  
  479. static tTree GenRandomize
  480. # if defined __STDC__ | defined __cplusplus
  481. (register tTree t)
  482. # else
  483. (t)
  484.  register tTree t;
  485. # endif
  486. {
  487. # line 263 "AdaptCM.puma"
  488.  
  489. tTree new;
  490. tIdent pname;
  491.  
  492.   if (t->Kind == kACF_BASIC) {
  493.   if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
  494. # line 268 "AdaptCM.puma"
  495.   {
  496. # line 270 "AdaptCM.puma"
  497.  if (IsHost)
  498.         new = NoTree;
  499.       else
  500.         { pname = MakeDalibId ("random_init");
  501.           t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID = mPROC_OBJ (pname);
  502.           new = t;
  503.         }
  504.  
  505.   }
  506.    return new;
  507.  
  508.   }
  509.   }
  510.  yyAbort ("GenRandomize");
  511. }
  512.  
  513. void BeginAdaptCM ()
  514. {
  515. }
  516.  
  517. void CloseAdaptCM ()
  518. {
  519. }
  520.